home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
drdobbs
/
1991
/
06
/
clock_p.asc
< prev
next >
Wrap
Text File
|
1991-05-02
|
22KB
|
657 lines
_USING THE REAL-TIME CLOCK_
by Kenneth Roach
[TURBO PASCAL VERSION]
[LISTING ONE]
(*
** TIMELIB.PAS
** (C) Copyright 1990 by Kenneth Roach
** This module contains procedures similar to Turbo Pascal's GetTime and
** GetDate procedures, but which are based on use of the AT class of
** system's real time clock. Additionally, procedures and functions are
** provided to enable and disable periodic interrupts from the real time
** clock along with an interrupt handler for same. Interrupts from the
** real time clock are provided at a rate of 1024 per second, and a
** function is provided to return the number of interrupts received in the
** current second. Also provided are emulations of the C language's
** time(), ctime() and clock() functions.
*)
Unit TimeLib;
Interface
Uses Dos;
Type
TimeString = String[24];
TimeStrPtr = ^TimeString;
Function RtcClock : LongInt;
Function MilliCount : Integer;
Function CTime2(Time : LongInt) : TimeStrPtr;
Procedure RtcTime(Var Where : LongInt);
Procedure Time2(Var Result : LongInt);
Procedure EnableRtcInts;
Procedure DisableRtcInts;
Procedure GetRtcTime(Var Hr,Mn,Sc,Hn : Word);
Procedure GetRtcDate(Var Yr,Mo,Dy : Word);
Implementation
Type
ShortString = String[3];
OldVec = Procedure;
Const
CLI = $FA;
STI = $FB;
MASK_24 = $02;
BCD_MASK = $04;
CMOSFLAG = $70;
CMOSDATA = $71;
SECONDS_REQ = $00;
MINUTES_REQ = $02;
HOURS_REQ = $04;
STATUSA = $0A;
DATE_REQ = $07;
MONTH_REQ = $08;
YEAR_REQ = $09;
CENTURY_REQ = $32;
UPDATE = $80;
HINIBBLE = $F0;
LONIBBLE = $0F;
SECS_PER_MIN = 60;
SECS_PER_HOUR = 3600;
SECS_PER_DAY = 86400;
SECS_PER_YEAR = 31536000;
MINS_PER_HOUR = 60;
DAYS_PER_YEAR = 365;
BASE_YEAR = 1980;
DAYS_PER_WEEK = 7;
TUESDAY = 3; { day of week for 1-1-1980 }
APRIL = 4;
JUNE = 6;
SEPTEMBER = 9;
NOVEMBER = 11;
FEBRUARY = 2;
RTC_VEC = $70;
IMR2 = $A1;
CMD1 = $20;
CMD2 = $A0;
EOI = $20;
RTC_MASK = $FE;
STATUSB = $0B;
STATUSC = $0C;
RTC_FLAG = $40;
Months : Array[1..12] of ShortString =
('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
Days : Array[1..7] of ShortString =
('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
Var
Bcd : Boolean;
RtcCount : Integer;
TickCount : LongInt;
OldRtcVec : Pointer;
OldCall : OldVec;
OldMask : Byte;
TimeStr : TimeString;
(*
** emulation of the C language clock() function. RtcClock returns
** a value corresponding to the number of periodic interrupts which
** have occurred since interrupts from the real time clock were
** enabled. The value will remain positive for some 24 days from
** initialization.
*)
Function RtcClock : LongInt;
Begin
RtcClock := TickCount;
End;
(*
** MilliCount returns the real time clock periodic interrupt count for
** the current second. Range of value is 0 to 1023.
*)
Function MilliCount : Integer;
Begin
MilliCount := RtcCount;
End;
(*
** real time clock interrupt handler
*)
Procedure Rtc; Interrupt;
Begin
Inline(CLI);
Port[CMOSFLAG] := STATUSC; { determine cause of interrupt }
If (Port[CMOSDATA] and $40) <> 0 Then { is it for us? }
Begin
Inc(RtcCount); { update number of times ISR called this second }
Inc(TickCount); { update total number of times called }
If RtcCount = 1024 Then { if start of new second then }
RtcCount := 0 { reset RtcCount }
Else
Begin
Port[CMOSFLAG] := STATUSA; { check it again for accuracy }
If (Port[CMOSDATA] and UPDATE) <> 0 Then
RtcCount := 0;
End;
Port[CMD1] := EOI; { signal end of interrupt to primary 8259 }
Port[CMD2] := EOI; { signal end of interrupt to chained 8259 }
End
Else
OldCall; { not for us, so call bios ISR }
Inline(STI);
End;
(*
** turn on interrupts from the real time clock
*)
Procedure EnableRtcInts;
Begin
RtcCount := 0; { reset ISR counter values }
TickCount := 0;
GetIntVec(RTC_VEC,OldRtcVec);
Move(OldRtcVec^,OldCall,Sizeof(Pointer)); { fake out Pascal... }
SetIntVec(RTC_VEC,@Rtc); { point to interrupt handler }
Port[IMR2] := Port[IMR2] and RTC_MASK; { enable clock interrupt }
Port[CMOSFLAG] := STATUSB;
OldMask := Port[CMOSDATA]; { get rtc mask register }
Port[CMOSFLAG] := STATUSB;
Port[CMOSDATA] := OldMask or RTC_FLAG; { enable periodic interrupts }
End;
(*
** turn off interrupts from the real time clock
*)
Procedure DisableRtcInts;
Begin
Port[CMOSFLAG] := STATUSB;
Port[CMOSDATA] := OldMask; { turn off periodic interrupts }
Port[IMR2] := Port[IMR2] and (not RTC_MASK); { reset 8259 mask }
SetIntVec(RTC_VEC,OldRtcVec); { remove our ISR }
End;
(*
** emulation of the C language's ctime() function
*)
Function CTime2(Time : LongInt) : TimeStrPtr;
Var
Hr,Mn,Sc : Word;
Yr,Mo,Dy : Word;
Bias,Dw,T : Word;
Junk,S : Byte;
Temp : LongInt;
Begin
Temp := Time mod SECS_PER_DAY; { get seconds left for this day }
Hr := Temp div SECS_PER_HOUR; { determine hours this day }
Temp := Temp mod SECS_PER_HOUR; { lose hours this day }
Mn := Temp div MINS_PER_HOUR; { determine minutes this hour }
Sc := Temp mod SECS_PER_MIN; { determine seconds this minute }
Inline(CLI);
Repeat { duplicate a bit of code for speed }
Port[CMOSFLAG] := STATUSA; { wait until not in update mode }
Until (Port[CMOSDATA] and UPDATE) = 0;
Port[CMOSFLAG] := CENTURY_REQ; T := Port[CMOSDATA]; { get century }
Port[CMOSFLAG] := YEAR_REQ; Bias := Port[CMOSDATA]; { get year }
Port[CMOSFLAG] := MONTH_REQ; Mo := Port[CMOSDATA]; { get month }
Port[CMOSFLAG] := DATE_REQ; Dy := Port[CMOSDATA]; { get day }
Inline(STI);
If Bcd Then { convert from BCD to binary as required }
Begin
T := ((T and HINIBBLE) shr 4) * 10 + (T and LONIBBLE);
Bias := ((Bias and HINIBBLE) shr 4) * 10 + (Bias and LONIBBLE);
Mo := ((Mo and HINIBBLE) shr 4) * 10 + (Mo and LONIBBLE);
Dy := ((Dy and HINIBBLE) shr 4) * 10 + (Dy and LONIBBLE);
End;
Inc(Bias,T * 100);
Temp := Time div SECS_PER_DAY; { get number of days for this value }
Yr := Temp div DAYS_PER_YEAR; { now convert it to years }
Bias := (Bias - BASE_YEAR) shr 2; { get leap year days for value }
Dy := Temp - Yr * DAYS_PER_YEAR - Bias; { get unprocessed days }
Inc(Dy); { add back 'today' }
Inc(Yr,BASE_YEAR); { now add in the 1980 start date }
Dw := Time div SECS_PER_DAY + TUESDAY; { 1-1-80 was a Tuesday }
Dw := Dw mod DAYS_PER_WEEK; { determine weekday }
Mo := 1; S := 1; { now determine the month's name }
While S <> 0 Do { process total remaining days for year }
Begin
Junk := 0;
Case S of
APRIL,
JUNE,
SEPTEMBER,
NOVEMBER: If Dy >= 30 Then { month has 30 days in it }
Junk := 30;
FEBRUARY: If (Yr shr 2) = 0 Then { special case february }
If Dy >= 29 Then
Junk := 29
Else
Else If Dy >= 28 Then
Junk := 28;
Else If Dy >= 31 Then
Junk := 31; { else month has 31 days }
End;
If Junk <> 0 Then
Begin
Inc(Mo); { account for month just processed }
Inc(S); { bump case index }
Dec(Dy,Junk); { subtract days just processed }
End
Else
S := 0; { Dy is less than 1 month, clear while var }
End;
TimeStr[1] := Days[Dw][1]; { now convert all values to a string }
TimeStr[2] := Days[Dw][2]; { done inline for speed }
TimeStr[3] := Days[Dw][3];
TimeStr[4] := ' ';
TimeStr[5] := Months[Mo][1];
TimeStr[6] := Months[Mo][2];
TimeStr[7] := Months[Mo][3];
TimeStr[8] := ' ';
TimeStr[9] := Chr(Dy div 10 + Ord('0'));
TimeStr[10] := Chr(Dy mod 10 + Ord('0'));
TimeStr[11] := ' ';
TimeStr[12] := Chr(Hr div 10 + Ord('0'));
TimeStr[13] := Chr(Hr mod 10 + Ord('0'));
TimeStr[14] := ':';
TimeStr[15] := Chr(Mn div 10 + Ord('0'));
TimeStr[16] := Chr(Mn mod 10 + Ord('0'));
TimeStr[17] := ':';
TimeStr[18] := Chr(Sc div 10 + Ord('0'));
TimeStr[19] := Chr(Sc mod 10 + Ord('0'));
TimeStr[20] := ' ';
TimeStr[21] := Chr(Yr div 1000 + Ord('0')); Yr := Yr mod 1000;
TimeStr[22] := Chr(Yr div 100 + Ord('0')); Yr := Yr mod 100;
TimeStr[23] := Chr(Yr div 10 + Ord('0'));
TimeStr[24] := Chr(Yr mod 10 + Ord('0'));
TimeStr[0] := Chr(24);
CTime2 := @TimeStr;
End;
(*
** replacement for Turbo Pascal's GetTime procedure
*)
Procedure GetRtcTime(Var Hr,Mn,Sc,Hn : Word);
Begin
Inline(CLI);
Repeat
Port[CMOSFLAG] := STATUSA; { wait until not in update cycle }
Until (Port[CMOSDATA] and UPDATE) = 0;
Port[CMOSFLAG] := SECONDS_REQ; Sc := Port[CMOSDATA]; { get seconds }
Port[CMOSFLAG] := MINUTES_REQ; Mn := Port[CMOSDATA]; { get minutes }
Port[CMOSFLAG] := HOURS_REQ; Hr := Port[CMOSDATA]; { get hour }
Inline(STI);
If Bcd Then { convert from BCD to binary as required }
Begin
Sc := ((Sc and HINIBBLE) shr 4) * 10 + (Sc and LONIBBLE);
Mn := ((Mn and HINIBBLE) shr 4) * 10 + (Mn and LONIBBLE);
Hr := ((Hr and HINIBBLE) shr 4) * 10 + (Hr and LONIBBLE);
End;
Hn := RtcCount div 10; { RtcCount goes to 1024 }
If Hn > 75 Then { correct for values to 102 each second }
Dec(Hn,3)
Else If Hn > 50 Then
Dec(Hn,2)
Else If Hn > 25 Then
Dec(Hn);
End;
(*
** replacement for Turbo Pascal's GetDate procedure
*)
Procedure GetRtcDate(Var Yr, Mo, Dy : Word);
Var T : Integer;
Begin
Inline(CLI);
Repeat
Port[CMOSFLAG] := STATUSA; { wait until not in update mode }
Until (Port[CMOSDATA] and UPDATE) = 0;
Port[CMOSFLAG] := CENTURY_REQ; T := Port[CMOSDATA]; { get century }
Port[CMOSFLAG] := YEAR_REQ; Yr := Port[CMOSDATA]; { get year }
Port[CMOSFLAG] := MONTH_REQ; Mo := Port[CMOSDATA]; { get month }
Port[CMOSFLAG] := DATE_REQ; Dy := Port[CMOSDATA]; { get day }
Inline(STI);
If Bcd Then { convert time from BCD to binary as required }
Begin
T := ((T and HINIBBLE) shr 4) * 10 + (T and LONIBBLE);
Yr := ((Yr and HINIBBLE) shr 4) * 10 + (Yr and LONIBBLE);
Mo := ((Mo and HINIBBLE) shr 4) * 10 + (Mo and LONIBBLE);
Dy := ((Dy and HINIBBLE) shr 4) * 10 + (Dy and LONIBBLE);
End;
Inc(Yr,T * 100); { add in century }
End;
(*
** emulation of the C language's time() function
*)
Procedure RtcTime(Var Where : LongInt);
Var
Hr : LongInt;
T,S,B,Yr,Sc,Mn,Mo,Dy : Word;
Begin
Inline(CLI); { following code is duplicated for speed }
Repeat
Port[CMOSFLAG] := STATUSA;
Until (Port[CMOSDATA] and UPDATE) = 0;
Port[CMOSFLAG] := SECONDS_REQ; Sc := Port[CMOSDATA]; { get seconds }
Port[CMOSFLAG] := MINUTES_REQ; Mn := Port[CMOSDATA]; { get minutes }
Port[CMOSFLAG] := HOURS_REQ; Hr := Port[CMOSDATA]; { get hour }
Port[CMOSFLAG] := CENTURY_REQ; T := Port[CMOSDATA]; { get century }
Port[CMOSFLAG] := YEAR_REQ; Yr := Port[CMOSDATA]; { get year }
Port[CMOSFLAG] := MONTH_REQ; Mo := Port[CMOSDATA]; { get month }
Port[CMOSFLAG] := DATE_REQ; Dy := Port[CMOSDATA]; { get day }
Inline(STI);
If Bcd Then { convert time from BCD to binary as required }
Begin
Sc := ((Sc and HINIBBLE) shr 4) * 10 + (Sc and LONIBBLE);
Mn := ((Mn and HINIBBLE) shr 4) * 10 + (Mn and LONIBBLE);
Hr := ((Hr and HINIBBLE) shr 4) * 10 + (Hr and LONIBBLE);
T := ((T and HINIBBLE) shr 4) * 10 + (T and LONIBBLE);
Yr := ((Yr and HINIBBLE) shr 4) * 10 + (Yr and LONIBBLE);
Mo := ((Mo and HINIBBLE) shr 4) * 10 + (Mo and LONIBBLE);
Dy := ((Dy and HINIBBLE) shr 4) * 10 + (Dy and LONIBBLE);
End;
Inline(STI);
Mn := Mn * SECS_PER_MIN + Sc; { convert today's values to seconds }
Hr := Hr * SECS_PER_HOUR + Mn;
Inc(Yr,T * 100); { account for century }
Dec(Yr,BASE_YEAR); { keep years since 1980 }
Inc(Dy,(Yr shr 2)); { check leap years }
S := 1;
While S < Mo Do { add days for this year }
Begin
Case S of
APRIL,
JUNE,
SEPTEMBER, { month has 30 days in it }
NOVEMBER: Inc(Dy,30);
FEBRUARY: If (Yr shr 2) = 0 Then { is this year a leap year? }
Inc(Dy,29) { yes }
Else
Inc(Dy,28); { no }
Else Inc(Dy,31); { else month has 31 days }
End;
Inc(S);
End;
Dec(Dy); { lose today... }
Where := Yr * SECS_PER_YEAR + { return final value }
Dy * SECS_PER_DAY + Hr;
End;
(*
** Pascal substitute for Turbo-C's time() function, based on calls to
** GetDate, GetTime. Provided for use on systems not equipped with a
** real time clock.
*)
Procedure Time2(Var Result : LongInt);
Var
H : LongInt;
S,Hr,Yr,Sc,Mn,Mo,Dy : Word;
Begin
GetTime(Hr,Mn,Sc,S); { get time from Turbo Pascal }
Mn := Mn * 60 + Sc; { convert to seconds }
H := Hr * 3600 + Mn;
GetDate(Yr,Mo,Dy,S); { get date from Turbo Pascal }
Dec(Yr,1980); { get years since 1980 }
Inc(Dy,Yr shr 2); { check leap years }
S := 1;
While S < Mo Do { add days for this year }
Begin
Case S of
APRIL,
JUNE,
SEPTEMBER,
NOVEMBER: Inc(Dy,30); { month has 30 days in it }
FEBRUARY: If (Yr shr 2) = 0 Then { is this year a leap year? }
Inc(Dy,29) { yes }
Else
Inc(Dy,28); { no }
Else Inc(Dy,31); { else month has 31 days }
End;
Inc(S);
End;
Result := (Yr * SECS_PER_YEAR + { return final value }
Dy * SECS_PER_DAY + H);
End;
(*
** unit initialization
*)
Begin
Port[CMOSFLAG] := STATUSB;
Bcd := (Port[CMOSDATA] and BCD_MASK) = 0; { check for BCD mode }
Port[CMOSFLAG] := STATUSB;
Port[CMOSDATA] := Port[CMOSDATA] or MASK_24; { force 24 hour mode }
RtcCount := 0;
TickCount := 0;
End.
[LISTING TWO]
(*
** TIME_PAS
** (C) Copyright 1990 by Kenneth Roach
** This program uses the time and date functions provided by Turbo Pascal
** compiler, as well as similar functions contained in the module TIMELIB.PAS.
** TIME_PAS calls each function for five seconds, counting the number of
** times the function in question was called. It then compares the number
** of times each function was called and displays the results. Following
** this, it displays the current date and time obtained from the
** GetRtcTime function, and as reported and converted by the RtcTime
** and CTime2 functions.
*)
Program TimePas;
Uses Dos,Crt,TimeLib;
Const
TEST_TIME = 5120; { 5 seconds * 1024 ticks per second }
Var
GrtCount : LongInt; { counter for GetRtcTime calls }
GtCount : LongInt; { counter for GetTime calls }
GrdCount : LongInt; { counter for GetRtcDate calls }
GdCount : LongInt; { counter for GetDate calls }
TCount : LongInt; { counter for Time calls }
RtCount : LongInt; { counter for RtcTime calls }
CtCount : LongInt; { counter for CTime2 calls }
Timer1 : LongInt; { used in Time, RtcTime testing }
Temp : LongInt;
Hr,Mn,Sc,Hn : Word; { used in calls to GetTime, GetRtcTime }
Yr,Mo,Dy,Dw : Word; { used in calls to GetDate, GetRtcDate }
St : TimeStrPtr; { used in CTime2 testing }
(*
** test performance of real time clock based time functions
*)
Procedure TestRtc;
Begin
Writeln;
Write('Testing GetRtcTime...');
Temp := RtcClock; { get current time tick count }
Repeat
GetRtcTime(Hr,Mn,Sc,Hn);
Inc(GrtCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
Writeln;
Write('Testing GetRtcDate...');
Temp := RtcClock;
Repeat
GetRtcDate(Yr,Mo,Dy);
Inc(GrdCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
Writeln;
Write('Testing RtcTime...');
Temp := RtcClock;
Repeat
RtcTime(Timer1);
Inc(RtCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
Writeln;
Write('Testing CTime2...');
Temp := RtcClock;
Repeat
St := CTime2(Timer1);
Inc(CtCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
End;
(*
** test performance of Turbo Pascal/DOS based time functions
*)
Procedure TestPas;
Begin
Writeln;
Write('Testing GetTime...');
Temp := RtcClock;
Repeat
GetTime(Hr,Mn,Sc,Hn);
Inc(GtCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
Writeln;
Write('Testing GetDate...');
Temp := RtcClock;
Repeat
GetDate(Yr,Mo,Dy,Dw);
Inc(GdCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
Writeln;
Write('Testing Time2...');
Temp := RtcClock;
Repeat
Time2(Timer1);
Inc(TCount);
Until (RtcClock - Temp) = TEST_TIME; { count for 5 seconds }
End;
(*
** determine percentage one value represents of another
*)
Function Percent(Count1,Count2 : LongInt) : LongInt;
Var Temp : LongInt;
Begin
Temp := (Count1 * 100) div Count2;
If ((Count1 * 100) mod Count2) >= 50 Then
Inc(Temp);
Percent := Temp;
End;
(*
** show results of timing tests
*)
Procedure DisplayResults;
Begin
Writeln;
Writeln('Test Summary:');
Writeln;
Writeln('GetTime called ',GtCount,' times');
Writeln('GetRtcTime called ',GrtCount,' times');
If GrtCount > GtCount Then
Writeln('GetRtcTime was ',Percent(GrtCount,GtCount),
'% the speed of GetTime')
Else
Writeln('GetTime was ',Percent(GtCount,GrtCount),
'% the speed of GetRtcTime');
Writeln;
Writeln('GetDate called ',GdCount,' times');
Writeln('GetRtcDate called ',GrdCount,' times');
If GrdCount > GdCount Then
Writeln('GetRtcDate was ',Percent(GrdCount,GdCount),
'% the speed of GetDate')
Else
Writeln('GetDate was ',Percent(GdCount,GrdCount),
'% the speed of GetRtcDate');
Writeln;
Writeln('Time2 called ',TCount,' times');
Writeln('RtcTime called ',RtCount,' times');
If TCount > RtCount Then
Writeln('Time2 was ',Percent(TCount,RtCount),
'% the speed of RtcTime')
Else
Writeln('RtcTime was ',Percent(RtCount,TCount),
'% the speed of Time2');
Writeln;
Writeln('CTime2 called ',CtCount,' times');
End;
Begin
GrtCount := 0; { initialize counter variables }
GtCount := 0;
GrdCount := 0;
GdCount := 0;
TCount := 0;
RtCount := 0;
CtCount := 0;
EnableRtcInts;
ClrScr;
TestRtc; { test the functions using the real time clock }
TestPas; { test the normal Pascal/DOS based time functions }
DisplayResults;
Writeln;
Writeln('End of test.');
Writeln('Start time display.');
Writeln('Depress any key to stop');
Writeln;
While not KeyPressed Do
Begin
GetRtcTime(Hr,Mn,Sc,Hn);
RtcTime(Timer1);
Write(Chr(13),Hr:2,':',Mn:2,':',Sc:2,'.',Hn:2,
' ',CTime2(Timer1)^);
End;
DisableRtcInts;
End.